home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / PBLIB1 / UNITS / OBJTFILE.INC < prev    next >
Text File  |  1994-04-26  |  3KB  |  159 lines
  1. {SECTION  TFILE_object }
  2. procedure TFILE_object.init(fn : string; create : boolean);
  3. var fdir   : string[40];
  4.     fname  : string[8];
  5.     fext   : string[4];
  6.      begin
  7.      opened   := false;
  8.      filename := fn;
  9.      linenum  := 0;
  10.      PosCurr  := 0;
  11.      err := 0;
  12.      TFILE_object.open(filename,create);
  13.      end;
  14.  
  15.  
  16. procedure TFILE_object.InitAppend(fn : string);
  17. var fdir   : string[40];
  18.     fname  : string[8];
  19.     fext   : string[4];
  20.      begin
  21.      opened   := false;
  22.      filename := fn;
  23.      linenum  := 0;
  24.      PosCurr  := 0;
  25.      err := 0;
  26.      if not FileExists(fn) then
  27.           begin
  28.           TFILE_object.open(filename,true);
  29.           end
  30.      else begin
  31.           assign(fil,fn);
  32.           {$I-} System.Append(fil); {$I+}
  33.           opened := not IOResultErrChk;
  34.           end;
  35.      end;
  36.  
  37.  
  38. procedure TFILE_object.done;
  39.      begin
  40.      TFILE_object.close;
  41.      end;
  42.  
  43.  
  44. Function TFILE_object.IOResultErrChk : boolean;
  45.      begin
  46.      err := IORESULT;
  47.      if err = 0 then
  48.           IOResultErrChk := false
  49.      else IOResultErrChk := true;
  50.      if err <> 0 then
  51.           writeln('tfile error [',filename,']  ',err);
  52.      end;
  53.  
  54.  
  55.  
  56. Procedure TFILE_object.open(fn : string; create : boolean);
  57.      begin
  58.      linenum := 0;
  59.      if opened then TFILE_object.close;
  60.      assign(fil,fn);
  61.      if create then
  62.           {$I-} ReWrite(fil) {$I+}
  63.      else begin
  64.           {$I-} Reset(fil); {$I+}
  65.           end;
  66.      opened := not IOResultErrChk;
  67.      end;
  68.  
  69.  
  70. Procedure TFILE_object.seek(l : longint);
  71. var ok : boolean;
  72.     ch  : char;
  73.      begin
  74.      if opened then ok := TextSeek(fil,l);
  75.      PosCurr := l;
  76.      linenum := -1; {no way top compute}
  77.      end;
  78.  
  79.  
  80. Function  TFILE_object.currentposition : longint;
  81.      begin
  82.      PosCurr := textpos(fil);
  83.      currentposition := PosCurr;
  84.      end;
  85.  
  86.  
  87. Function TFILE_object.fetchnext(var s : string) : boolean;
  88. var ok : boolean;
  89.      begin
  90.      ok := false;
  91.      s := '';
  92.      if opened and not EOF(fil) then
  93.           begin
  94.          {$I-} SYSTEM.readln(fil,s); {$I+}
  95.           if not IOResultErrChk then
  96.                begin
  97.                inc(linenum);
  98.                ok := true;
  99.                end;
  100.           end;
  101.      fetchnext := ok;
  102.      end;
  103.  
  104.  
  105. Function  TFILE_object.append(s : string) : boolean;
  106. var ok : boolean;
  107.      begin
  108.      ok := false;
  109.      if opened then
  110.           begin
  111.          {$I-}
  112.           SYSTEM.writeln(fil,s);
  113.          {$I+}
  114.           if not IOResultErrChk then
  115.                begin
  116.                inc(linenum);
  117.                ok := true;
  118.                end;
  119.           end;
  120.      append := ok;
  121.      end;
  122.  
  123.  
  124.  
  125. procedure TFILE_object.close;
  126.      begin
  127.      if opened then
  128.           begin
  129.          {$I-} SYSTEM.Close(fil); {$I+}
  130.           IOResultErrChk;
  131.           opened := false;
  132.           end;
  133.      end;
  134.  
  135.  
  136. procedure TFILE_object.clearfile;
  137. var fn : string;
  138.      begin
  139.      fn := filename;
  140.      TFILE_object.close;
  141.      TFILE_object.open(fn,true);      { do a REWRITE }
  142.      end;
  143.  
  144.  
  145. procedure TFILE_object.refreshfile;
  146. var fn : string;
  147.      begin
  148.      fn := filename;
  149.      TFILE_object.close;
  150.      TFILE_object.open(fn,false);      { do a RESET }
  151.      end;
  152.  
  153.  
  154. Function  TFILE_object.error : boolean;
  155.      begin
  156.      if err <> 0 then error := true
  157.      else error := false;
  158.      end;
  159.